library(dplyr) #数据处理和数据分析的包
library(ggplot2) #数据可视化包
library(chron) #用于处理时间
library(reshape2) #数据重塑和重新排列数据框
library(readxl) #读取excel数据
library(wordcloud2) #词云可视化库

makdata <- read_excel("694.xlsx")

#一般数据处理
#检查缺失值
is.na(makdata)
sum(is.na(makdata))
#检查字符串空格
which(grepl(" ", makdata$出库员))
which(grepl(" ", makdata$产品名称))
which(grepl(" ", makdata$产品代码))
#删除产品名称的空格
makdata$产品名称 <- gsub(" ", "", makdata$产品名称)
which(grepl(" ", makdata$产品名称))

#可以发现负数金额和为0单价
summary(makdata) 
str(makdata)

#无效信息处理
#查询金额小于=0可以发现存在四舍五入和会员积分这种无效产品数据
print(subset(makdata,makdata$金额<=0),n=1000) 
nrow(subset(makdata,makdata$产品名称=="四舍五入"))
nrow(subset(makdata,makdata$产品名称=="会员积分"))
#进行剔除
makdata<-subset(makdata,makdata$产品名称!="四舍五入"&makdata$产品名称!="会员积分")
print(subset(makdata,makdata$金额<=0),n=1000)

#合并订单产品
sumdata <- makdata %>%
  select(c(数量,金额)) %>%
  #按单据产品汇总
  aggregate(by=list(单据号=makdata$单据号,产品代码=makdata$产品代码),FUN=sum) %>%
  #按单据号排序
  arrange(单据号) %>%
  #按照单据产品合并
  merge(unique(makdata[,1:5]),by=c("单据号","产品代码"),all=FALSE) %>%
  #计算单价
  mutate(单价=金额/数量)

#查看金额小于0的退货订单  [1] 74
nrow(subset(sumdata,sumdata$金额<0))
#数据量不大直接删除
sumdata<-subset(sumdata,sumdata$金额>0)
#查看整洁数据
summary(sumdata)

#转换因子变量
sumdata[,1]<-as.factor(sumdata[,1])
sumdata[,2]<-as.factor(sumdata[,2])
sumdata[,5]<-as.factor(sumdata[,5])
sumdata[,7]<-as.factor(sumdata[,7])
str(sumdata)

#开始数据分析
#获取为日期对象的天周月,并转换因子变量
sumdata<-mutate(sumdata,日=days(出库时间),周=weekdays(出库时间),月=months(出库时间))
sumdata[,9]<-as.factor(sumdata[,9])
sumdata[,10]<-factor(sumdata[,10],order=TRUE,levels = c("星期一","星期二","星期三","星期四","星期五","星期六","星期日"))
sumdata[,11]<-factor(sumdata[,11],order=TRUE,levels = c("十月","十一月","十二月","一月","二月"))
sumdata$出库时间<-as.Date(sumdata$出库时间)
str(sumdata)

#时间序列分析 按日期,日,周,月汇总金额数据/订单量（均值）
#只关注趋势增长情况,对数据标准化,消除量纲的影响
#时间-总金额
time_amount <- tapply(sumdata$金额,sumdata$出库时间,sum)
#时间-产品数量
time_goods <- tapply(sumdata$单据号,sumdata$出库时间,length)
#合并
time_ser <- rbind(time_amount,time_goods)%>%t()%>%as.data.frame()
names(time_ser)<-c("金额","产品数")
time_ser$时间<-rownames(time_ser)
rownames(time_ser)<-NULL
#转换时间序列
time_ser$时间<-strptime(time_ser$时间,"%Y-%m-%d")
#计算订单数
order_sum<-sumdata%>%
  group_by(出库时间)%>%
  summarise(订单数=n_distinct(单据号))
names(order_sum)<-c("时间","订单数")
time_ser<-cbind(time_ser,order_sum[,2])
str(time_ser)

#标准化处理-消除不同维度变量之间的量纲差异、减少变量对结果的影响
time_ser[,c(1,2,4)]<-scale(time_ser[,c(1,2,4)])
time_ser$时间<-as.Date(time_ser$时间)
#绘制时间金额情况汇总图
md<-melt(time_ser,id.vars=c("时间"),
         measure.vars=c("金额", "产品数", "订单数"),
         variable.name="类型", value.name="值")
x<-md$时间
y<-md$值
z<-md$类型
ggplot(md,aes(x=x,y=y,color=z,group=z))+
  geom_line(size=1)+
  geom_point(size=2,shape=21,fill="white")+
  labs(y="标准化后值",x="时间",color="项目类型")+
  theme(legend.position=c(0.5,1),legend.justification=c(0.5,1))+
  ggtitle("按时间金额情况汇总图")
#从该图分析发现
#2月存在明显的金额和订单数背离,可以推测为过年节日,采购年货导致客单价提高
#每日出库的金额具有波浪式周期性,周期为一天
#11月存在销售明显下滑,推测即将到达双11活动,购买欲显著下降
#10月-2月销售整体上呈现先下降后上升的特征,推测可能气温有关

#分析出库金额、产品数、订单数)-(1日-31日)关系
day_amount<-tapply(sumdata$金额,sumdata$日,sum)
day_goods<-tapply(sumdata$单据号,sumdata$日,length)
day_ser <-sumdata%>%
  select(出库时间,日)%>%
  unique()%>%
  .$日%>%
  table()%>%
  rbind(day_amount,day_goods,.)%>%
  t()%>%
  as.data.frame()
names(day_ser)<-c("金额","产品数","频数")
day_ser<-day_ser%>%
  mutate(日均出库金额=金额/频数,日均出库产品数=产品数/频数)%>%
  cbind(日期=row.names(.),.)
row.names(day_ser)=NULL
#计算订单数
order_sum2<-sumdata%>%
  group_by(日)%>%
  summarise(订单数=n_distinct(单据号))
names(order_sum2)<-c("日期","订单数")
day_ser<-cbind(day_ser,order_sum2[,2])
day_ser$日期<-factor(day_ser$日期,order=TRUE,levels = c(1:31))
str(day_ser)

#标准化处理
day_ser[,5:7]<-scale(day_ser[,5:7])

md2<-melt(day_ser, id.vars=c("日期"),
         measure.vars=c("日均出库金额", "日均出库产品数", "订单数"),
         variable.name="类型", value.name="值")
x<-md2$日期
y<-md2$值
z<-md2$类型
ggplot(md2,aes(x=x,y=y,color=z,group=z))+
  geom_line(size=1)+
  geom_point(size=2,shape=21,fill="white")+
  labs(y="标准化后值",x="日期",color="类型")+
  theme(legend.position=c(0,1),legend.justification=c(0,1))+
  ggtitle("按日期出库情况汇总图")

#从该图分析出
#18号出库金额远好于其它日期,查看日历发现是除夕节,是年货高峰
#日均出库金额、日均出库产品数、订单数 符合美国分析家艾略特的波浪理论具有波浪式周期性。
#每月月中出库金额和订单数一般好于月初和月末,推测消费者月中发工资购买力上升,导致月中高于月初和月末的现象


#金额、产品数、订单数  周一到周日关系
week_amount<-tapply(sumdata$金额,sumdata$周,sum)
week_goods<-tapply(sumdata$单据号,sumdata$周,length)
weeb_ser<-sumdata%>%
  select(出库时间,周)%>%
  unique()%>%
  .$周%>%
  table()%>%
  rbind(week_amount,week_goods,.)%>%
  t()%>%
  as.data.frame()
names(weeb_ser)<-c("金额","产品数","频数")
weeb_ser$时间<-row.names(weeb_ser)
row.names(weeb_ser)=NULL
weeb_ser<-mutate(weeb_ser,日均金额=金额/频数,日均产品数=产品数/频数)

order_sum3<-sumdata%>%
  group_by(周)%>%
  summarise(订单数=n_distinct(单据号))
names(order_sum3)<-c("时间","订单数")
weeb_ser<-cbind(weeb_ser,order_sum3[,2])
weeb_ser$时间<-factor(weeb_ser$时间,order=TRUE,levels = c("星期一","星期二","星期三","星期四","星期五","星期六","星期日"))
weeb_ser[,5:7]<-scale(weeb_ser[,5:7])
md3<-melt(weeb_ser, id.vars=c("时间"),
         measure.vars=c("日均金额", "日均产品数", "订单数"),
         variable.name="类型", value.name="值")
x<-md3$时间
y<-md3$值
z<-md3$类型
ggplot(md3,aes(x=x,y=y,color=z,group=z))+
  geom_line(size=1)+
  geom_point(size=2,shape=21,fill="white")+
  labs(y="标准化后值",x="时间",color="类型")+
  theme(legend.position=c(0,1),legend.justification=c(0,1))+
  ggtitle("按周出库汇总图")

#从该图可以发现
#日均金额、产品数和订单数具有波浪式周期性,周期为 1 天
#周末的销售情况远好于工作日
#销售随着周一到周五递升,周六达到顶峰


#金额、产品数、订单数  10月到2月关系
month_amount<-tapply(sumdata$金额,sumdata$月,sum)
month_goods<-tapply(sumdata$单据号,sumdata$月,length)
month_ser<-sumdata%>%
  select(出库时间,月)%>%
  unique()%>%
  .$月%>%
  table()%>%
  rbind(month_amount,month_goods,.)%>%
  t()%>%
  as.data.frame()
names(month_ser)<-c("金额","产品数","频数")
month_ser$时间<-row.names(month_ser)
row.names(month_ser)=NULL
month_ser<-mutate(month_ser,月均金额=金额/频数,月均产品数=产品数/频数)
order_sum4<-sumdata%>%
  group_by(月)%>%
  summarise(订单数=n_distinct(单据号))
names(order_sum4)<-c("时间","订单数")
month_ser<-cbind(month_ser,order_sum4[,2])
month_ser$时间<-factor(month_ser$时间,order=TRUE,levels = c("十月","十一月","十二月","一月","二月"))

month_ser[,5:7]<-scale(month_ser[,5:7])
md4<-melt(month_ser, id.vars=c("时间"),
         measure.vars=c("月均金额", "月均产品数", "订单数"),
         variable.name="类型", value.name="值")
x<-md4$时间
y<-md4$值
z<-md4$类型
ggplot(md4,aes(x=x,y=y,color=z,group=z))+
  geom_line(size=1)+
  geom_point(size=2,shape=21,fill="white")+
  labs(y="标准化后值",x="时间",color="类型")+
  theme(legend.position=c(0.5,1),legend.justification=c(0.5,1))+
  ggtitle("按月出库汇总图")

#从该图可以发现：
#月均金额、月均产品数、订单数 不同月 销售差异较大
#月均金额和月均产品数在十二月达到低点回升,推测可能随温度降低人们能量消耗降低,去购买频次不变而单次购买变少。
#一月二月虽然气温依低却金额回升可能和节日有关
#二月金额显著高于其他月份,猜测节日采购年货有关
#二月订单数没有随金额显著增加,猜测企业内部园区超市,消费群体稳定


##产品信息分析
##统计出库商品信息
#整体产品出库量
out_num<-sumdata%>%
  group_by(产品名称)%>%
  summarise(出库量=n())%>%
  arrange(desc(出库量))

##由于产品总数有2千多种,不方便分析所有产品的出库与时间的关系。所以方便起见,
#我们选取热销的30产品为样本,按时间类型分别分析热销产品与出库时间的出库量。
top30<-out_num[1:30,1]
top30<-top30$产品名称

#产品出库量的分布图
out_num<-as.data.frame(out_num)
wordcloud2(data = out_num)

##从该图可以发现,产品之间销量差异较大,绝大大部分产品销量较小,可
##能具有传统的长尾效应或幂率分布的特征。

goods_num<-out_num%>%
  group_by(out_num[,2])%>%
  summarise(产品数=n_distinct(产品名称))
names(goods_num)<-c("出库量","产品数")

ggplot(goods_num,aes(出库量,y=产品数))+
  geom_line(size=1)+
  xlim(0,100)+
  ggtitle("不同出库量的产品数分布")
#从该图可以发现,不同出库量的产品数符合典型的幂率分布或者说长尾效应,
#大部分产品的出库量都小于50,可能和产品能分类过于详细的数据量会加剧长尾效应有关。


#TOP30产品出库月份情况分布图
hsbm<-sumdata%>%
  select(产品名称,数量,月)%>%
  dcast(月~产品名称,value.var="数量",sum)%>%
  as.data.frame()
md5<-hsbm%>%
  melt(id.vars=c("月"),variable.name="产品名称", value.name="数量")%>%
  filter(产品名称 %in% top30)
x<-md5$产品名称
y<-md5$数量
z<-md5$月
ggplot(md5,aes(x=x,y=y,color=z,group=z))+
  geom_line(size=1)+
  geom_point(size=2,shape=21,fill="white")+
  labs(y="数量",x="产品名称",color="月")+
  theme(legend.position=c(1,1),legend.justification=c(1,1))+
  theme(axis.text.x=element_text(angle=90,hjust=1))+
  ggtitle("TOP30产品出库月份情况分布图")

#从该图可以发现
#大部分热销产品不同时间的出库情况没有显著差异
#南京(红)，苏烟，红杉树，玉溪等烟类产品在一二月份中销售最多，可能和年终或节日送礼习俗有关，
#也可能和年底工薪阶层业绩压力较大有关。这类产品在其它月份销售很差，表明该类
#产品出库有明显周期性，可能受节日影响较大。
#台湾肉肠在十一月到二月的出库最多，猜测天气变冷，很多人更喜欢吃热的烤肠
#运动型饮料，茶类饮料，果汁类饮料，每个月的销售情况接近，而且销售总量接近，
#表明不同饮料类型偏好的消费者的比例可能类似，而且市场比较成熟和稳定了
#大号购物袋在一二月份明显增多猜测随着天气变冷，人们为了不冻手及携带方便，更愿意购买大购物袋



